R Notebook

library(tidyverse, verbose = F)

── Attaching core tidyverse packages ───────────────────────────────────────────────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.4.4     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.2     ── Conflicts ─────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the ]8;;http://conflicted.r-lib.org/conflicted package]8;; to force all conflicts to become errorsWarning message:
In readRDS(path) : error al leer desde conexión

source("Funciones.R")

Lectura de Datos

Lo datos corresponde a una matriz 5x5x10. La metadata será X = 1…25 y Z = 1…10 (profundidad), ambos detectores tienen la misma metadata.

##Metadata
Metadata <- data.frame(x = rep(1:100, each = 11), 
                       z = rep(1:11, 100))

Comp.data <- data.frame(muestra = c("ss406", "ss407", "ss408", "ss409", "ss410"), 
                        C = c(0.19,0.50,0.28,0.11,0.39),
                        Mn = c(0.53,0.13,0.64,0.48,0.43),
                        Ni = c(1.69,0.61,4.58,3.14,2.04),
                        Cr = c(2.12,3.00,0.09,1.22,1.72),
                        Mo = c(1.03,0.82,0.14,0.77,0.41),
                        Cu = c(0.32,0.43,0.73,0.23,0.47))

DEMON

data.dir <- "Data/demon/"

wl <- read_tsv(paste(data.dir,"ss406.asc",sep = ""), col_names = F, progress = F, show_col_types = F) %>% 
        .[,1] %>% set_names("wl") %>% rowid_to_column()

## DEMON data
L_Demon <- map(c("ss406.asc","ss407.asc","ss408.asc","ss409.asc","ss410.asc"), 
               ~ read_tsv(paste(data.dir,.x,sep = ""), col_names = F, progress = F, show_col_types = F)) 

L_Demon <- L_Demon %>% set_names(c("ss406","ss407","ss408","ss409","ss410"))  

L_Demon <- L_Demon %>% map(~ .x %>% setNames(c("wl",paste("X", 1:(ncol(.x)-1), sep = ""))))

## elimina shot 1
L_Demon <- L_Demon %>% 
  map(~ .x %>% .[, c(1, which(Metadata$z != 1) + 1)]) ## elimina disparo #1 (limpieza)

g <- L_Demon %>% map(~ data.frame(.x[,1], Int = apply(.x[,2:ncol(.x)], 1, mean))) %>% bind_rows(.id = "id") %>% 
  ggplot(aes(x = wl, y = Int, color = id)) + geom_line() + labs(x = "Wavelength")
g %>% plotly::ggplotly()

Registered S3 method overwritten by 'data.table':
  method           from
  print.data.table     
Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

## Normalizar
izq <- 267.70
der <- 267.75
int <- L_Demon %>% map_dfr(fun.int, izq = izq, der = der)
factor <-  1
int_norm <- int/factor

## acumular
int_norm <- sumar_filas_por_grupos(int_norm, n = 10, wl = F)

## Promediar
int_norm <- cbind(Comp.data, int_norm)
int_norm %>% pivot_longer(X1:X100, values_to = "Libs.Int") %>%
  ggplot(aes(x = Libs.Int, y = Cr, color = muestra)) + 
    geom_point() + 
    geom_hline(yintercept = int_norm$Cr, lty = 2, col = "gray")

int_mean <- apply(int_norm %>% select(X1:X100), 1, promediar_grupos_aleatorios, n=10) %>% t() %>% data.frame()
int_mean <- cbind(Comp.data, int_mean)
int_mean %>% pivot_longer(X1:X10, values_to = "Libs.Int") %>% 
  ggplot(aes(x = Libs.Int, y = Cr, color = muestra)) + 
    geom_point() + 
    geom_hline(yintercept = int_norm$Cr, lty = 2, col = "gray")

int_mean %>% pivot_longer(X1:X10, values_to = "Libs.Int") %>% 
  ggplot(aes(x = Libs.Int, y = Cr, color = muestra)) + 
    geom_boxplot() + 
    geom_hline(yintercept = int_norm$Cr, lty = 2, col = "gray")

MECHELLE

data.dir <- "Data/mechelle/"
## Mechelle data
L_Mechelle <- map(c("ss406.asc","ss407.asc","ss408.asc","ss409.asc","ss410.asc"), 
                  ~ read_tsv(paste(data.dir,.x,sep = ""), col_names = F, progress = F, show_col_types = F)) 
View(fun.WL.calibration)

L_Mechelle <- L_Mechelle %>% map(~ .x %>% setNames(c("wl",paste("X", 1:(ncol(.x)-1), sep = ""))))
L_Mechelle <- L_Mechelle %>% set_names(c("ss406","ss407","ss408","ss409","ss410"))  

Exploracion Cromo

## elimina shot 1
L_Mechelle <- L_Mechelle %>% 
  map(~ .x %>% .[, c(1, which(Metadata$z != 1) + 1)]) ## elimina disparo #1 (limpieza)

g <- L_Mechelle %>% map(~ data.frame(.x[,1], Int = apply(.x[,2:ncol(.x)], 1, mean))) %>% bind_rows(.id = "id") %>% 
  ggplot(aes(x = wl, y = Int, color = id)) + geom_line() + labs(x = "Wavelength")
g %>% plotly::ggplotly()

Wavelength Calibration

Normalizando por suma total 200-1000

Acumular (z) - Normalizar - Promediar (x)

## acumular
L <- L_Mechelle_new %>% map(~ .x %>% sumar_filas_por_grupos(n = 10))
  
## Normalizar
int <- L %>% map_dfr(fun.int, izq = 267.64, der = 267.74)
factor <- L %>% map_dfr(fun.int, izq = 268.40, der = 268.50)
int_norm <- int/factor

## Promediar
int_norm <- cbind(Comp.data, int_norm)
int_norm %>% pivot_longer(X1:X100, values_to = "Libs.Int") %>% 
    ggplot(aes(x = Libs.Int, y = Cr, color = muestra)) + 
        geom_point()

int_mean <- apply(int_norm %>% select(X1:X100), 1, promediar_grupos_aleatorios, n=10) %>% t() %>% data.frame()
int_mean <- cbind(Comp.data, int_mean)

int_mean %>% pivot_longer(X1:X10, values_to = "Libs.Int") %>% 
  ggplot(aes(x = Libs.Int, y = Cr, color = muestra)) + 
    geom_point() + 
    geom_hline(yintercept = int_norm$Cr, lty = 2, col = "gray")

int_mean %>% pivot_longer(X1:X10, values_to = "Libs.Int") %>% 
  ggplot(aes(x = Libs.Int, y = Cr, color = muestra)) + 
    geom_boxplot() + 
    geom_hline(yintercept = int_norm$Cr, lty = 2, col = "gray")

Normalizar - Acumular (z) - promediar (x)

## Normalizar

int <- L_Mechelle_new %>% map_dfr(fun.int, izq = 267.64, der = 267.74)
factor <- L_Mechelle_new %>% map_dfr(fun.int, izq = 268.40, der = 268.50)
int_norm <- int/factor

## acumular
L <- L_Mechelle_new %>% map(~ .x %>% sumar_filas_por_grupos(n = 10))

## Promediar
int_norm <- cbind(Comp.data, int_norm)
int_norm %>% pivot_longer(X1:X100, values_to = "Libs.Int") %>% ggplot(aes(x = Libs.Int, y = Cr, color = muestra)) + geom_boxplot()

Normalizando por suma total 200-600

Acumular (z) - Normalizar - Promediar (x)

## acumular
L <- L_Mechelle_new %>% map(~ .x %>% sumar_filas_por_grupos(n = 10))
  
## Normalizar
izq = 267.62; der = 267.77
int <- L %>% map_dfr(fun.int, izq = izq, der = der)
factor <- L %>% map_dfr(fun.int, izq = 200, der = 600)
int_norm <- int/factor

## Promediar
int_norm <- cbind(Comp.data, int_norm)
int_norm %>% pivot_longer(X1:X100, values_to = "Libs.Int") %>% ggplot(aes(x = Libs.Int, y = Cr, color = muestra)) + geom_boxplot()

Normalizar - Acumular (z) - promediar (x)

## Normalizar
izq = 267.62; der = 267.77
int <- L_Mechelle_new %>% map_dfr(fun.int, izq = izq, der = der)
factor <- L_Mechelle_new %>% map_dfr(fun.int, izq = 200, der = 600)
int_norm <- int/factor

## acumular
L <- L_Mechelle_new %>% map(~ .x %>% sumar_filas_por_grupos(n = 10))

## Promediar
int_norm <- cbind(Comp.data, int_norm)
int_norm %>% pivot_longer(X1:X100, values_to = "Libs.Int") %>% ggplot(aes(x = Libs.Int, y = Cr, color = muestra)) + geom_boxplot()